perm filename SC1.FOR[ZZZ,LCS] blob
sn#439879 filedate 1979-05-08 generic text, type T, neo UTF8
C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
C 1/79 ********** SCORE - PDP11 VERSION **********
C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP11 MUSIC V SOUND
C GENERATION PROGRAM.
C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C LOAD 'S1' WITH S2,SCANR
COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
COMMON /Q/ BNW(200),NWZ /INS/RINST(27),BG(60) /TYP/JOUT,LN,KTYPE
1 /ITYP/ITYP,JED
C SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
COMMON/VV/LIMIT,V(2000) /A/NP(27),XT(27), FRM(80),INVIS(27)
DIMENSION LIST(1),JNP(80)
C WITH VX,IOUT AT 70 AND FRM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE.
C 2ND NUM IN IPT=NUMP+2. (NUMPY)
COMMON /PCIP/ PCH(27,33) /ALPH/IALPH(14),ISCA(12),IDAT(11)
1 /INP/INP(154)
C NUMP=30 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
COMMON J,L /DUR/DUR(27) /NUMP/NUMP,NUMPY,NUMPX
1 /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS,IQT
1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
1 ,VX(70),IAMP,K,KN,M,ML,CODE
COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,FLNM
1 /INTC/LPAR,IPRN,IRETRO,INVRT,ICON,LCNT,
1 JZ,MLX,IZ,JD,LEND,ITMP,LP,ILIT,NLIT,KTMP,IC,IA
1 /REALC/QX,PARENS,BY,ALL,QTS,RAX,RD,T4,AC
EQUIVALENCE (LIST,FRM(3)),(JNP,INP)
DATA KZY/27/,ISEMI/';'/,LIMIT/2000/,NUMP/30/,KSLA/'/'/,IQT/'"'/
1,MINUS/'-'/,ISTAR/'*'/,ICOMM/','/,ICOL/':'/,ILESS/'<'/
DATA IBLA/' '/,TYPE/'TYPE'/,TYPD/'TYPD'/,
1 HELP/'HELP'/,IQUES/'?'/,EDIT/'EDIT'/
1 ,ISCA/'C','P','D','O','E','F','Z','G','S','A','T','B'/
1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
1,IALPH/'H','I','J','K','L','M','N','Q','R','U','V','W','X'
1,'Y'/
ITYP=0
JOUT=JTYPE
C*** ABOVE CAUSE TYPEOUT ON SCREEN (PUT IN PROMPT FOR THIS LATER.)
LPAR=0
IPRN=0
QX=0
MOT=0
IRETRO=-1
INVRT=-1
ICON=-1
LCNT=1
IPAREN=0
JZ=1
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
T5=0
NINS=0
K=0
IDALL=-1
QTS=-1.
NWZ=1
BNW(1)=0
I=1
KL=0
TP=0
RA=0
CHN=0
DO 127 K=1,77,3
127 LIST(K)=0
C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
NWX=0
BY=-1
DO 1128 K=1,KZY
INVIS(K)=0
RINST(K)=0
NP(K)=0
IQ(K)=0
DO 1128 L=1,32
1128 PCH(K,L)=0
ITYP=-1
JED=-1
2112 WRITE(JTYPE,8002)
READ(JTYPE,1)JNP
IF(JNP(1).NE.IBLA)GO TO 4112
IF(FLNM.EQ.0)GO TO 2112
RNAM=FLNM
C REMEMBERS LAST FILE NAME GIVEN.
GO TO 129
4112 CALL PACKER(RNAM,JNP)
C**** ONLY UP TO 4 LETTERS IN FILE NAMES.
999 IF(RNAM.NE.EDIT)GO TO 3112
JED=0
GO TO 2112
C 'EDIT' GOES TO EDIT MODE
3112 IF(RNAM.NE.TYPE)GO TO 128
ITYP=0
FLNM=TYPD
C***************** OPEN AN OUTPUT FILE *********
CALL DISKO(ID20,FLNM,2)
C KOUT=DEVICE NUMBER, FLNM=FILE NAME, 0=OUTPUT, (-1=INPUT)
CALL READIT
C******* IS A5 AVAILABLE?? *************
1 FORMAT(80A1)
8002 FORMAT(' TYPE FILE NAME-- '$)
300 FORMAT(I,3F)
128 IF(RNAM.NE.HELP)GO TO 129
C *** NO HELP YET***
129 FLNM=RNAM
C*********** OPEN AN INPUT FILE ******************
CALL DISKO(ID23,FLNM,1)
CALL OUTINF
C OUTINF IS A DUMMY IF USING 2-PART SCORE. WITH 1-PART SCORE IT PROMPTS
C FOR OUTPUT INFO.
CALL READIT
END